home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0152_Re: How do I get the Disk Serials?.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-30  |  3.8 KB  |  149 lines
  1. {
  2. > >I've got code to do this in Turbo Pascal, using the DOS Services interrupt
  3. > >(21), function number 69H.  But this does not work in Delphi.  I'm sure this
  4. > >can be done using the DOS3CALL function, but I've tried and tried, and I can't
  5. > >seem to get it to work.  Any ideas?
  6. >
  7. > >Mike
  8. > >m.d.bews@swansea.ac.uk
  9. >
  10. > This will do it !
  11. }
  12.  unit Procs;
  13.  
  14.  interface
  15.  
  16.  uses
  17.    Forms, DB, DBGrids, DBTables, Graphics, Classes, Dialogs;
  18.  
  19.  Type
  20.       TRWBlock = Record
  21.          rwSpecFunc: Byte;
  22.          rwHead: Word;
  23.          rwCylinder: Word;
  24.          rwFirstSector: Word;
  25.          rwSectors: Word;
  26.          rwBufPtr: Pointer;
  27.       End;
  28.  
  29.       TBootSector = Record
  30.           bsJump: Array[0..2] of Byte;
  31.           bsOemName: Array[0..7] of Char;
  32.           bsBytesPerSec: Word;
  33.           bsSecPerClust: Byte;
  34.           bsResSectors: Word;
  35.           bsFATs: Byte;
  36.           bsRootDirEnts: Word;
  37.           bsSectors: Word;
  38.           bsMedia: Byte;
  39.           bsFATSecs: Word;
  40.           bsSecPerTrack: Word;
  41.           bsHeads: Word;
  42.           bsHiddensecs: Longint;
  43.           bsHugeSectors: LongInt;
  44.           bsDriveNumber: Byte;
  45.           bsReserved: Byte;
  46.           bsBootsignature: Byte;
  47.           bsVolumeID: Array[0..3] of Byte;
  48.           bsVolumeLabel: Array[0..10] of Char;
  49.           bsFileSysType: Array[0..7] of Char;
  50.       End;
  51.  
  52.  Const RWBlock: TRWBlock = (rwSpecFunc: 0;
  53.                             rwHead: 0;
  54.                             rwCylinder: 0;
  55.                             rwfirstSector: 0;
  56.                             rwSectors: 1;
  57.                             rwBufPtr: nil);
  58.  
  59.  Function ReadBootSector(Drive: Word; Var BootSector: TBootsector): Boolean;
  60.  
  61.  implementation
  62.  
  63.  Uses MsgForm;
  64.  
  65.  Function ReadBootSector(Drive: Word; Var BootSector: TBootsector): Boolean;
  66.  Var Buffer: Array[0..1023] of Byte; Status: Word;
  67.  Begin
  68.     RWBlock.rwBufPtr := addr(Buffer);
  69.     asm
  70.          mov         bx, Drive
  71.          mov         ch, 08h
  72.          mov         cl, 61h
  73.          mov         dx, seg RWBlock
  74.          mov         ds, dx
  75.          mov         dx, offset RWBlock
  76.          mov         ax, 440dh
  77.          int         21h
  78.          jc          @Error_handler
  79.          jmp         @ok
  80.       @Error_handler:
  81.          mov         Status, ax
  82.          jmp         @exit
  83.       @ok:
  84.          mov         status, 0
  85.       @exit:
  86.     End;
  87.     ReadBootSector := Status = 0;
  88.     If Status = 0 Then Move(Buffer, BootSector, SizeOf(TBootSector));
  89.  End;
  90.  
  91.  end.
  92.  
  93. { -------------  ANOTHER WAY TO DO IT -------------------- }
  94.  
  95. Type
  96.   InfoBuffer = RECORD
  97.     InfoLevel : WORD;
  98.     Serial : DWord;
  99.     VolLabel : ARRAY [0..10]OF CHAR;
  100.     FileSystem : ARRAY [0..7]OF CHAR;
  101. End;
  102.  
  103. Function TFMain.GetDiskSerNo(Drive : Byte) : String;
  104. Const
  105.   HexDigits : ARRAY [0..15]OF CHAR = '0123456789ABCDEF';
  106. Var
  107.   IB   : InfoBuffer;
  108.   N    : WORD;
  109.  
  110.   Function SerialStr (L : LONGINT) : String;
  111.   Var
  112.     Temp : String;
  113.   Begin
  114.     {Temp [0] := #9; }
  115.     Temp [1] := HexDigits [L SHR 28];
  116.     Temp [2] := HexDigits [ (L SHR 24) AND $F];
  117.     Temp [3] := HexDigits [ (L SHR 20) AND $F];
  118.     Temp [4] := HexDigits [ (L SHR 16) AND $F];
  119.     Temp [5] := '-';
  120.     Temp [6] := HexDigits [ (L SHR 12) AND $F];
  121.     Temp [7] := HexDigits [ (L SHR 8) AND $F];
  122.     Temp [8] := HexDigits [ (L SHR 4) AND $F];
  123.     Temp [9] := HexDigits [L AND $F];
  124.     SerialStr := Temp;
  125.   End;
  126.  
  127.   Function GetSerial (DiskNum : BYTE; VAR I : InfoBuffer) : WORD; assembler;
  128.     asm
  129.       MOV AH, 69h
  130.       MOV AL, 00h
  131.       MOV BL, DiskNum
  132.       PUSH DS
  133.       LDS DX, I  {error here "Operand Size Mismatch I"}
  134.       INT 21h
  135.       POP DS
  136.       JC @Bad
  137.       XOR AX, AX
  138.       @Bad :
  139.     end;
  140.  
  141. Begin
  142.   N := GetSerial (Drive, IB);
  143.   If N = 0 then
  144.     Result := SerialStr (IB.Serial)
  145.   else
  146.     Result := 'Error Reading Disk';
  147. End;
  148.  
  149.